home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / TVFM.ZIP / COLORS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  2.7 KB  |  116 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision File Manager Demo               }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit Colors;
  9.  
  10. {$X+,V-}
  11.  
  12. interface
  13.  
  14. procedure SelectNewColors;
  15.  
  16. implementation
  17.  
  18. uses Memory, Drivers, Objects, Views, Dialogs, StdDlg, App, Equ, Dos,
  19.   MsgBox;
  20.  
  21. const
  22.   cmPreview = 100;
  23.  
  24. const
  25.   PaletteMask = '*.PAL';
  26.  
  27. type
  28.   PColorDialog = ^TColorDialog;
  29.   TColorDialog = object(TFileDialog)
  30.     NewPalette: TPalette;
  31.     SavePalette: TPalette;
  32.     constructor Init(AWildCard: TWildStr; const ATitle,
  33.       InputName: String; AOptions: Word; HistoryId: Byte);
  34.     procedure HandleEvent(var Event: TEvent); virtual;
  35.     function LoadPalette: Boolean;
  36.     function Valid(Command: Word): Boolean; virtual;
  37.   end;
  38.  
  39.  
  40. { TColorDialog }
  41. constructor TColorDialog.Init(AWildCard: TWildStr; const ATitle,
  42.   InputName: String; AOptions: Word; HistoryId: Byte);
  43. var
  44.   R: TRect;
  45. begin
  46.   inherited Init(AWildCard, ATitle, InputName, AOptions, HistoryId);
  47.   SavePalette := Application^.GetPalette^;
  48.   R.Assign(35,10,46,12);
  49.   Insert(New(PButton, Init(R, 'Pre~v~iew', cmPreview, bfNormal)));
  50.   SelectNext(False);
  51. end;
  52.  
  53. { Loads the specified palette into the NewPalette variable }
  54. function TColorDialog.LoadPalette: Boolean;
  55. var
  56.   F: File;
  57.   Result: Integer;
  58.   PalSize: Integer;
  59.   Name: FNameStr;
  60. begin
  61.   GetFileName(Name);
  62.   LoadPalette := False;
  63.   Assign(F, Name);
  64. {$I-}
  65.   Reset(F,1);
  66. {$I+}
  67.   Result := IOResult;
  68.   if Result <> 0 then
  69.   begin
  70.     MessageBox('Unable to load ' + Name, nil, mfError + mfOKButton);
  71.     Exit;
  72.   end;
  73.   BlockRead(F, NewPalette[1], 255, PalSize);
  74.   NewPalette[0] := Char(PalSize);
  75.   System.Close(F);
  76.   Application^.GetPalette^ := NewPalette;
  77.   DoneMemory;
  78.   Application^.ReDraw;
  79.   LoadPalette := True;
  80. end;
  81.  
  82. procedure TColorDialog.HandleEvent(var Event: TEvent);
  83. var
  84.   PalName: FNameStr;
  85. begin
  86.   if (Event.What = evCommand) and ((Event.Command = cmPreview) or
  87.     (Event.Command = cmOK)) then
  88.     LoadPalette;
  89.   inherited HandleEvent(Event);
  90. end;
  91.  
  92. function TColorDialog.Valid(Command: Word): Boolean;
  93. var
  94.   PalName: FNameStr;
  95. begin
  96.   Valid := inherited Valid(Command);
  97.   if Command = cmFileOpen then
  98.     LoadPalette
  99.   else if Command = cmCancel then
  100.   begin
  101.     Application^.GetPalette^ := SavePalette;
  102.     DoneMemory;
  103.     Application^.ReDraw;
  104.   end;
  105. end;
  106.  
  107. procedure SelectNewColors;
  108. var
  109.   D: PColorDialog;
  110. begin
  111.   D := New(PColorDialog, Init(PaletteMask, 'Select Color', '~P~alette Name',
  112.     fdOpenButton, 100));
  113.   Application^.ExecuteDialog(D, nil);
  114. end;
  115.  
  116. end.